perm filename ROADED.SAI[1,BGB] blob sn#001261 filedate 1972-10-22 generic text, type T, neo UTF8
00100	BEGIN "ROADED"
00200		DEFINE α="COMMENT",∂="DATUM";
00300	α WORLD MODEL DATA;
00400		EXTERNAL REAL   ARRAY LOCII[0:400,1:3];
00500		EXTERNAL INTEGER ARRAY ARCS[1:300,1:3];
00600		EXTERNAL INTEGER ARRAY SEGS[1:300,1:2];
00700	α LEAP DECLARATIONS;
00800		REQUIRE 100 NEW_ITEMS;
00900		REQUIRE 100 PNAMES;
01000		ITEM NIL;
01100	α EXTERNAL COMMAND PROCEDURES;
01200		EXTERNAL PROCEDURE FLYCAM;
01300	α TTY COMMAND SCANNER DATA;
01400		STRING WORD,LINE,SUBR,ARGS;
01500		INTEGER CHR,BRKCHR,I,N;
01600		REAL ARG;
01700		BREAKSET(1,"()[]←","I");
01800	α MAIN LISTEN LOOP;
01900		WHILE TRUE DO
02000	BEGIN
02100		LABEL EOL;
02200		OUTSTR("*");
02300		LINE	←	INCHWL;
02400		IF LENGTH(LINE)=0 THEN GO EOL;
02500	
02600		IF EQU(LINE,"FLYCAM") THEN BEGIN FLYCAM;GO EOL END;
     

00100		ARGS	←	LINE;
00200		SUBR	←	SCAN(ARGS,1,BRKCHR);
00300		IF BRKCHR="(" THEN
00400	BEGIN	"SUBRS"
00500	
00600		IF EQU(SUBR,"CURLY") THEN
00700	BEGIN	"CURLY"
00800		INTEGER ARRAY ITEMVAR IT;
00900		INTEGER FLG,I,IMAX;
01000		WORD	←	SCAN(ARGS,1,BRKCHR);
01100		IT	←	CVSI(WORD,FLG);
01200		IF FLG THEN GO EOL;
01300		IMAX	←	ARRINFO(∂(IT),0);
01400		OUTCHR("(");
01500		FOR I←1 STEP 1 UNTIL IMAX DO
01600	BEGIN
01700		OUTSTR(CVS(∂(IT)[I]));
01800		IF I=IMAX THEN OUTSTR(")"&13&10) ELSE OUTCHR(",");
01900	END;	GO EOL;
02000	END	"CURLY";
     

00100		IF EQU(SUBR,"SETQ") THEN
00200	BEGIN	"SETQ"
00300		INTEGER ARRAY CURLGON[1:50];
00400		INTEGER ARRAY ITEMVAR IT;
00500		INTEGER FLG,I,IMAX;
00600		WORD	←	SCAN(ARGS,1,BRKCHR);
00700		I	←	0;
00800		DO CURLGON[I←I+1] ← INTSCAN(ARGS,BRKCHR) UNTIL BRKCHR=")";
00900		IT	←	CVSI(WORD,FLG);
01000		IF ¬FLG ∧ I=ARRINFO(∂(IT),0) THEN ARRBLT(∂(IT)[1],CURLGON[1],I) ELSE
01100	BEGIN
01200		INTEGER ARRAY NEWCURL[1:I];
01300		ARRBLT(NEWCURL[1],CURLGON[1],I);
01400		IF ¬FLG THEN
01500	BEGIN
01600		DEL_PNAME(IT);
01700		DELETE(IT);
01800	END;
01900		IT	←	NEW(NEWCURL);
02000		NEW_PNAME(IT,WORD);
02100	END;
02150		OUTSTR(9&WORD&13&10);
02200		GO EOL;
02300	END	"SETQ";
02400	
02500	END	"SUBRS";
     

00100	BEGIN	"EXPRS"
00200		CHR	←	LOP(LINE);
00300	α VERTEX EXAMINE AND DEPOSIT;
00400		IF CHR="V" THEN
00500	BEGIN
00600		N	←	INTSCAN(LINE,BRKCHR);
00700		IF BRKCHR THEN 
00800		IF BRKCHR="[" THEN
00900	BEGIN
01000		I	←	INTSCAN(LINE,BRKCHR);
01100		CHR	←	LOP(LINE);
01200		CHR	←	LOP(LINE);
01300		LOCII[N,I]←	REALSCAN(LINE,BRKCHR);
01400	END ELSE
01500	BEGIN
01600		LOCII[N,1]←	REALSCAN(LINE,BRKCHR);
01700		LOCII[N,2]←	REALSCAN(LINE,BRKCHR);
01800		LOCII[N,3]←	REALSCAN(LINE,BRKCHR);
01900	END;
02000		OUTSTR(9&CVG(LOCII[N,1]));
02100		OUTSTR(9&CVG(LOCII[N,2]));
02200		OUTSTR(9&CVG(LOCII[N,3]));
02300		OUTSTR(13&10);
02400		GO EOL;
02500	END;
     

00100	α SEGMENT EXAMINE AND DEPOSIT;
00200		IF CHR="S" THEN
00300	BEGIN
00400		N	←	INTSCAN(LINE,BRKCHR);
00500		IF BRKCHR THEN
00600		IF BRKCHR="[" THEN
00700	BEGIN
00800		I	←	INTSCAN(LINE,BRKCHR);
00900		CHR	←	LOP(LINE);
01000		CHR	←	LOP(LINE);
01100		SEGS[N,I]←	INTSCAN(LINE,BRKCHR);
01200	END ELSE
01300	BEGIN
01400		SEGS[N,1]←	INTSCAN(LINE,BRKCHR);
01500		SEGS[N,2]←	INTSCAN(LINE,BRKCHR);
01600	END;
01700		OUTSTR(9&CVS(SEGS[N,1]));
01800		OUTSTR(9&CVS(SEGS[N,2]));
01900		OUTSTR(13&10);
02000		GO EOL;
02100	END;
02200	
02300	α ARC EXAMINE AND DEPOSIT;
02400		IF CHR="A" THEN
02500	BEGIN
02600		N	←	INTSCAN(LINE,BRKCHR);
02700		IF BRKCHR THEN
02800		IF BRKCHR="[" THEN
02900	BEGIN
03000		I	←	INTSCAN(LINE,BRKCHR);
03100		CHR	←	LOP(LINE);
03200		CHR	←	LOP(LINE);
03300		ARCS[N,I]←	INTSCAN(LINE,BRKCHR);
03400	END ELSE
03500	BEGIN
03600		ARCS[N,1]←	INTSCAN(LINE,BRKCHR);
03700		ARCS[N,2]←	INTSCAN(LINE,BRKCHR);
03800		ARCS[N,3]←	INTSCAN(LINE,BRKCHR);
03900	END;
04000		OUTSTR(9&CVS(ARCS[N,1]));
04100		OUTSTR(9&CVS(ARCS[N,2]));
04200		OUTSTR(9&CVS(ARCS[N,3]));
04300		OUTSTR(13&10);
04400		GO EOL;
04500	END;
     

00100	END	"EXPRS";
00200	EOL:
00300	END;
00400	END